home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 4 / Amiga Tools 4.iso / tools / internet-tools / connect-line / cl / commands / rexx / cl-sneaker.clrexx < prev   
Encoding:
Text File  |  1996-02-07  |  13.5 KB  |  359 lines
  1. /*
  2. **  $VER: CL-Sneaker.clrexx 1.3 (18 Dez 1995)
  3. **
  4. **        © 1995 Ralf Ramge
  5. **
  6. **  PROGRAMNAME:
  7. **      CL-Sneaker.clrexx
  8. **
  9. **  FUNCTION:
  10. **      Demonstrationsskript für die cl_rexx.library, Connectline 5.0
  11. **
  12. **      Connectline © 1986-1995 Oliver Wagner, Mathias Mischler
  13. **      cl_rexx.library © 1995 Mathias Mischler
  14. **
  15. **      Haben Sie die Nase voll von vergammelten Binärteilen in ihrem
  16. **      System, welche von defekten Archiven nur so wimmeln, der Down-
  17. **      loadfreiraum munter erhöht wurde, in man ein File unter anderem
  18. **      Namen erneut uppte, oder gar Archive mit illegalen Inhalten ge-
  19. **      postet wurden?
  20. **
  21. **      Dieses Skript hilft Ihnen und den Brettverwaltern, für "Ruhe und
  22. **      Ordnung" zu sorgen ;)
  23. **
  24. **      'Sneaker' (auch 'Faker' genannt) sind Programme, mit welchen es
  25. **      vereinfacht wird, Brettinhalte sauber zu halten und Usern, die
  26. **      ein Faible für Uploads von Schrottsoftware haben, zu zeigen, daß
  27. **      das in Ihrem System nicht Usus ist. 'CL-Sneaker' ist einer der
  28. **      erbarmungslosesten Vertreter seiner Kategorie, er erlaubt dem Brett-
  29. **      verwalter, Brettzensor und der Systemadministration, einen Uploader
  30. **      bis ins Extrem zu quälen. Als einziger bietet er die Möglichkeit,
  31. **      nicht nur feste Werte vom aktuellen Download-Freiraum eines Users
  32. **      abzuziehen, sondern alternativ auch bis zu dreistellige Multipli-
  33. **      katoren und eine feste Zahl verbleibender Kilobyte Freiraum anzu-
  34. **      geben. Ebenso ist auch ein kompletter Entzug jeweiliger Zugriffs-
  35. **      berechtigungen auf eine ganze Gruppe möglich.
  36. **
  37. **      Installation:
  38. **
  39. **      Einbinden in die Shell-Prefs mit folgendem Aufruf
  40. **
  41. **          rx CONNECTLINE:Commands/Rexx/CL-Sneaker.clrexx %l
  42. **
  43. **      Hinweis: Die Userdaten werden nur geändert, wenn der betroffene User
  44. **      nicht zur Zeit des Bearbeitens im System eingeloggt ist.
  45. **      Die betroffenen Nachrichten werden nicht sofort gelöscht, sondern
  46. **      erst nach dem nächsten Start des Crunchers.
  47. **
  48. **  $HISTORY:
  49. **
  50. **   26 Nov 1995 : 1.0 : initial release
  51. **   30 Nov 1995 : 1.01: Carrier-Check (uuuuups)
  52. **   02 Dez 1995 : 1.1 : Abzug von FreeFiles möglich
  53. **   18 Jan 1996 : 1.2 : Umgebastelt auf CLGET/SET_UserFreeKByte()
  54. **   07 Feb 1996 : 1.3 : Diverse kosmetische Fixes
  55. **
  56. */
  57.  
  58. /* cl_rexx.library öffnen */
  59.  
  60. if ~show('L','cl_rexx.library') then do
  61.     ~addlib('cl_rexx.library',0,-30,0) then do
  62.     say 'Konnte Library nicht öffnen!'
  63.     exit
  64.     end
  65.  
  66. port=arg(1)
  67. user=CLGET_PortUsername(port)
  68. brett=CLGET_PortCurrentBoard(port)
  69.  
  70. grund.1='Falsches Brett                '
  71. grund.2='Inkorrekter Betreff           '
  72. grund.3='Bereits vorhanden             '
  73. grund.4='Zu alt                        '
  74. grund.5='Unvollständiges Archiv        '
  75. grund.6='Archiv defekt                 '
  76. grund.7='Raubkopie                     '
  77. grund.8='Verstößt gegen geltendes Recht'
  78.  
  79. sanction.1='Keine                                               '
  80. sanction.2='Download-Freiraum kürzen                            '
  81. sanction.3='Verwarnung an User schicken                         '
  82. sanction.4='Upload/Download-Ratio ändern                        '
  83. sanction.5='Zugriff auf alle Bretter der gleichen Gruppe sperren'
  84.  
  85. call cls
  86. if (CLGET_UserPriority(user)<99)&~(CLGET_BoardAdmin(brett)~=user)&~(CLGET_BoardCensor(brett)~=user) then do
  87.     say 'Sie sind in diesem Brett nicht berechtigt, die Inhalte zu ändern!'
  88.     exit
  89.     end
  90.  
  91. /* Eingabe und Parsen des Suchmusters */
  92.  
  93. call CL_PutStr('Welche Nachrichten :')
  94. pattern=CLONL_BlueRead(57)
  95. if (pattern='')|(pattern='-1') then exit
  96.  
  97. say 'Bitte warten, aktualisiere Datenbestand.'
  98.  
  99. messagectr=1
  100. pattern=translate(pattern,' ',',')
  101. do x=1 to words(pattern)
  102.     temppattern=translate(word(pattern,x),' ','-')
  103.     select
  104.         when words(temppattern)>1 then do
  105.             /* Wir haben eine Aufzählung, z.B. 4-20 */
  106.             first = word(temppattern,1)
  107.             second= word(temppattern,2)
  108.             if second<first then do         /* War sowas wie 300-280 */
  109.                 second=first+second         /* Also vertauschen wir  */
  110.                 first=second-first          /* die zwei Werte mittels*/
  111.                 second=second-first         /* Addition & Subtraktion*/
  112.                 end
  113.             end
  114.         when left(word(pattern,x),1)='-' then do
  115.             /* Aufzählung, z.B. -10 */
  116.             first=0
  117.             second=word(translate(word(pattern,x),' ','-'),1)
  118.             end
  119.         when right(word(pattern,x),1)='-' then do
  120.             /* Aufzählung, z.B. 10- */
  121.             first=word(translate(word(pattern,x),' ','-'),1)
  122.             second=CLGET_MsgNumberOf(brett)-1
  123.             end
  124.         when word(pattern,x)='*' then do
  125.             /* Alle Nachrichten */
  126.             first=0
  127.             second=CLGET_MsgNumberOf(brett)-1
  128.             end
  129.         otherwise do
  130.             first=word(pattern,x)
  131.             second=word(pattern,x)
  132.             end
  133.         end
  134.     do y=first to second
  135.     nachricht.messagectr=y
  136.     messagectr=messagectr+1
  137.     end
  138.  
  139.  
  140. /* Bearbeiten der Nachrichten */
  141.  
  142. do x=1 to messagectr
  143.     if nachricht.x~>CLGET_MsgNumberOf(brett) then do
  144.     absender=CLGET_MsgFrom(brett,nachricht.x)
  145.     betreff=CLGET_MsgSubject(brett,nachricht.x)
  146.     filename=CLGET_MsgFilename(brett,nachricht.x)
  147.     filelaenge=(CLGET_MsgBodyLength(brett,nachricht.x)/1024)%1
  148.     kommentar=CLGET_MsgShortComment(brett,nachricht.x)
  149.     readcount=CLGET_MsgReadCount(brett,nachricht.x)
  150.     if CLIS_MsgBinary(brett,nachricht.x) then typ='Binär'
  151.     else typ='Text'
  152.  
  153.     say ''
  154.     call CLONL_Color(3,0,1); call CL_PutStr('Absender  :'); call CLONL_Normal()
  155.     say absender
  156.     call CLONL_Color(3,0,1); call CL_PutStr('Betreff   :'); call CLONL_Normal()
  157.     say betreff
  158.     call CLONL_Color(3,0,1); call CL_PutStr('Typ       :'); call CLONL_Normal()
  159.     say typ
  160.     call CLONL_Color(3,0,1); call CL_PutStr('Filename  :'); call CLONL_Normal()
  161.     say filename
  162.     call CLONL_Color(3,0,1); call CL_PutStr('Kommentar :'); call CLONL_Normal()
  163.     say kommentar
  164.     call CLONL_Color(3,0,1); call CL_PutStr('Filelänge :'); call CLONL_Normal()
  165.     say filelaenge' KB'
  166.     call CLONL_Color(3,0,1); call CL_PutStr('Downloads :'); call CLONL_Normal()
  167.     say readcount
  168.     call CLONL_Color(5,0,0); call CL_PutStr(copies('-',79)); call CLONL_Normal()
  169.     say ''
  170.  
  171.     abbruch=false
  172.     taste=CLONL_ShortMenu('Weiter','Bearbeiten','Quit')
  173.     select
  174.         when taste='-1' then exit
  175.         when taste='W' then nop
  176.         when taste='B' then call bearbeiten
  177.         when taste='B' then abbruch=true
  178.         otherwise nop
  179.         end
  180.     if abbruch=true then exit
  181.     end
  182.     end
  183. exit
  184.  
  185. bearbeiten:
  186.  
  187.     say ''
  188.     say 'Bitte den Grund angeben:'
  189.     taste=CLONL_ShortMenuVertical(grund.1,grund.2,grund.3,grund.4,grund.5,grund.6,grund.7,grund.8,'Manuell eingeben','Quit')
  190.     select
  191.         when taste='F' then reason=grund.1
  192.         when taste='I' then reason=grund.2
  193.         when taste='B' then reason=grund.3
  194.         when taste='Z' then reason=grund.4
  195.         when taste='U' then reason=grund.5
  196.         when taste='A' then reason=grund.6
  197.         when taste='R' then reason=grund.7
  198.         when taste='V' then reason=grund.8
  199.         when taste='M' then reason=CLONL_BlueRead(79)
  200.         when taste='Q' then return
  201.         when taste='-1' then exit
  202.         otherwise nop
  203.         end
  204.     sender=word(translate(absender,' ','@'),1)
  205.     if (upper(word(translate(absender,'  ','@.'),2))=upper(CLGET_OwnSystemName()))&(CLIS_UserExists(sender)=1) then do
  206.         rate=CLGET_UserRate(sender)
  207.         dlkb=CLGET_UserDownloads(sender)
  208.         upkb=CLGET_UserFreeKByte(sender)
  209.         freiraum=(rate*upkb)-dlkb
  210.         say ''
  211.         say 'Der User 'sender' hat eine Ratio von 'rate':1 ,'CLGET_UserFreefiles(sender)' freie Files und 'freiraum' KB Freiraum.'
  212.         say 'Gewünschte Sanktion:'
  213.         taste2=CLONL_ShortMenuVertical(sanction.1,sanction.2,sanction.3,sanction.4,sanction.5)
  214.         select
  215.             when taste2='K' then nop
  216.             when taste2='D' then call lowerratio
  217.             when taste2='V' then call verwarnung
  218.             when taste2='U' then call changeratio
  219.             when taste2='Z' then call restrictedaccess
  220.             when taste2='-1' then exit
  221.             otherwise nop
  222.             end
  223.         say ''
  224.         say 'Führe Änderungen aus ...'
  225.         if open('out','T:sneaker.'port'.'user,'W') then do
  226.             call writeln 'out','Hallo 'upper(sender)'!'
  227.             call writeln 'out',''
  228.             call writeln 'out','Ihre Nachricht "'betreff'" im Brett 'brett
  229.             call writeln 'out','wurde von 'user' nicht akzeptiert. Als Grund gab er an:'
  230.             call writeln 'out',''
  231.             call writeln 'out','>>>>>>> 'upper(reason)
  232.             call writeln 'out',''
  233.             select
  234.                 when taste2='K' then nop
  235.                 when taste2='D' then do
  236.                     call writeln 'out','Daraufhin wurde ihr Freiraum um 'abs(faktor*filelaenge)' KB und 'fanz' Files'
  237.                     call writeln 'out','gekürzt.'
  238.                     end
  239.                 when taste2='V' then call writeln 'out','Daraufhin werden sie von 'user' verwarnt.'
  240.                 when taste2='U' then call writeln 'out','Daraufhin wurde ihre Ratio von 'rate':1 auf 'newratio':1 geändert.'
  241.                 when taste2='Z' then call writeln 'out','Daraufhin wurde ihnen der Zugang zur entsprechenden Gruppe verwehrt.'
  242.                 otherwise nop
  243.                 end
  244.             call writeln 'out',''
  245.             call writeln 'out','Bei Beschwerden wenden Sie sich bitte an die Systembetreuung.'
  246.             call writeln 'out',''
  247.             call writeln 'out','Hochachtungsvoll,'
  248.             call writeln 'out',''
  249.             call writeln 'out','           'upper(user)
  250.             call close 'out'
  251.  
  252.             call CLONL_Sendmail('Brettverwaltung 'brett,sender,'Ihre Nachricht','T:sneaker.'port'.'user)
  253.             call CLONL_Sendmail('Brettverwaltung 'brett,root,'Sneaker-Protokoll','T:sneaker.'port'.'user)
  254.             address command 'delete >NIL: T:sneaker.'port'.'user
  255.             end
  256.         rate=CLGET_UserRate(sender)
  257.         if rate>0 then do
  258.             call CLSET_MsgShortComment(brett,nachricht.x,'Gelöscht:<'reason'>')
  259.             newupd=((freiraum/rate)+(dlkb/rate))%1
  260.             call CLSET_UserFreeKByte(sender,newupd)
  261.             call CLSET_MsgDelete(brett,nachricht.x)
  262.             end
  263.         else say 'Keine Freiraumänderung, User hat Ratio 0!'
  264.     end
  265. return
  266.  
  267. changeratio:
  268.  
  269.     say ''
  270.     call CL_PutStr('Welche Ratio soll der User haben? ')
  271.     newratio=CLONL_BlueRead(3,rate)
  272.     if newratio='-1' then exit
  273.     call CLSET_UserRate(sender,newratio)
  274.     return
  275.  
  276. restrictedaccess:
  277.  
  278.     do p=1 to 96
  279.         if (CLIS_BoardGroup(brett,p))&(CLIS_UserGroup(sender,p)) then do
  280.             say 'Sperre Zugang für Gruppe: '||CLGET_GroupName(p)
  281.             call CLSET_UserGroup(sender,p,'0')
  282.             end
  283.         end
  284.     return
  285.  
  286. lowerratio:
  287.  
  288. factor.1='1. '   filelaenge' KB abziehen (Faktor 1, Freiraum:'freiraum-filelaenge' KB)'
  289. factor.2='2. ' 2*filelaenge' KB abziehen (Faktor 2, Freiraum:'freiraum-2*filelaenge' KB)'
  290. factor.3='3. ' 3*filelaenge' KB abziehen (Faktor 3, Freiraum:'freiraum-3*filelaenge' KB)'
  291. factor.4='4. ' 4*filelaenge' KB abziehen (Faktor 4, Freiraum:'freiraum-4*filelaenge' KB)'
  292. factor.5='5. ' 5*filelaenge' KB abziehen (Faktor 5, Freiraum:'freiraum-5*filelaenge' KB)'
  293. factor.6='6. ' 6*filelaenge' KB abziehen (Faktor 6, Freiraum:'freiraum-6*filelaenge' KB)'
  294. factor.7='7. ' 7*filelaenge' KB abziehen (Faktor 7, Freiraum:'freiraum-7*filelaenge' KB)'
  295. factor.8='8. ' 8*filelaenge' KB abziehen (Faktor 8, Freiraum:'freiraum-8*filelaenge' KB)'
  296. factor.9='9. ' 9*filelaenge' KB abziehen (Faktor 9, Freiraum:'freiraum-9*filelaenge' KB)'
  297.  
  298. taste=CLONL_ShortMenuVertical(factor.1,factor.2,factor.3,factor.4,factor.5,factor.6,factor.7,factor.8,factor.9,'Faktor manuell angeben','Abzug freier Files','Verbliebenen Freiraum manuell angeben','Restliche freie Files manuell angeben')
  299. select
  300.     when (taste>=1)&(taste<=9) then do
  301.         restfreiraum=freiraum-taste*filelaenge
  302.         faktor=taste
  303.         fanz=0
  304.         end
  305.     when taste='F' then do
  306.         call CL_PutStr('Bitte den Faktor angeben: ')
  307.         faktor=CLONL_BlueRead(3)
  308.         restfreiraum=freiraum-faktor*filelaenge
  309.         fanz=0
  310.         end
  311.     when taste='A' then do
  312.         ffiles=CLGET_UserFreeFiles(sender)
  313.         say sender' hat 'ffiles' freie Files.'
  314.         call CL_PutStr('Wieviele freie Files abziehen?: ')
  315.         fanz=CLONL_BlueRead(3,CLGET_UserRate(sender))
  316.         call CLSET_UserFreeFiles(sender,ffiles-fanz)
  317.         restfreiraum=freiraum
  318.         faktor=0
  319.         end
  320.     when (taste='V')&(filelaenge>0) then do
  321.         call CL_PutStr('Bitte den verbleibenden Freiraum angeben: ')
  322.         restfreiraum=(CLONL_BlueRead(length(freiraum)+1,freiraum))+1
  323.         faktor=(restfreiraum/filelaenge)-(freiraum/filelaenge)
  324.         fanz=0
  325.         end
  326.     when taste='R' then do
  327.         ffiles=CLGET_UserFreeFiles(sender)
  328.         call CL_PutStr('Bitte die verbleibenden freien Files angeben: ')
  329.         restfiles=CLONL_BlueRead(length(ffiles)+1,ffiles)
  330.         fanz=ffiles-restfiles
  331.         call CLSET_UserFreeFiles(sender,restfiles)
  332.         faktor=0
  333.         restfreiraum=freiraum
  334.         end
  335.     when taste='-1' then exit
  336.     otherwise do
  337.         faktor=0
  338.         restfreiraum=freiraum
  339.         end
  340.     end
  341. freiraum=restfreiraum
  342. return
  343.  
  344. verwarnung:
  345.  
  346.     call CL_Edit('T:Verwarnung.'port,)
  347.     call CLONL_Sendmail('Brettverwaltung 'brett,sender,'Verwarnung','T:Verwarnung.'port)
  348.     address command 'delete >NIL: t:Verwarnung.'port
  349.     return
  350.  
  351. cls:
  352.  
  353. if ~CLONL_ClearScreen() then exit
  354. call CLONL_BlueMode()
  355. say 'CL-Sneaker                                                                   '
  356. call CLONL_Normal()
  357. say ''
  358. return
  359.